home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / modes / modula2.el.z / modula2.el
Encoding:
Text File  |  1998-05-21  |  13.3 KB  |  474 lines
  1. ;;; modula2.el --- Modula-2 editing support package
  2.  
  3. ;; Author: Michael Schmidt <michael@pbinfo.UUCP> 
  4. ;;     Tom Perrine <Perrin@LOGICON.ARPA>
  5. ;; Keywords: languages
  6.  
  7. ;; This file is part of XEmacs.
  8.  
  9. ;; XEmacs is free software; you can redistribute it and/or modify it
  10. ;; under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; XEmacs is distributed in the hope that it will be useful, but
  15. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17. ;; General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  21. ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  22. ;; 02111-1307, USA.
  23.  
  24. ;;; Synched up with: FSF 19.34.
  25.  
  26. ;; The authors distributed this without a copyright notice
  27. ;; back in 1988, so it is in the public domain.  The original included
  28. ;; the following credit:
  29.  
  30. ;; Author Mick Jordan
  31. ;; amended Peter Robinson
  32.  
  33. ;;; Commentary:
  34.  
  35. ;; A major mode for editing Modula-2 code.  It provides convenient abbrevs
  36. ;; for Modula-2 keywords, knows about the standard layout rules, and supports
  37. ;; a native compile command.
  38.  
  39. ;;; Code:
  40.  
  41. ;;; Added by Tom Perrine (TEP)
  42. (defvar m2-mode-syntax-table nil
  43.   "Syntax table in use in Modula-2 buffers.")
  44.  
  45. (defvar m2-compile-command "m2c"
  46.   "Command to compile Modula-2 programs")
  47.  
  48. (defvar m2-link-command "m2l"
  49.   "Command to link Modula-2 programs")
  50.  
  51. (defvar m2-link-name nil
  52.   "Name of the executable.")
  53.  
  54.  
  55. (if m2-mode-syntax-table
  56.     ()
  57.   (let ((table (make-syntax-table)))
  58.     (modify-syntax-entry ?\\ "\\" table)
  59.     (modify-syntax-entry ?\( ". 1" table)
  60.     (modify-syntax-entry ?\) ". 4" table)
  61.     (modify-syntax-entry ?* ". 23" table)
  62.     (modify-syntax-entry ?+ "." table)
  63.     (modify-syntax-entry ?- "." table)
  64.     (modify-syntax-entry ?= "." table)
  65.     (modify-syntax-entry ?% "." table)
  66.     (modify-syntax-entry ?< "." table)
  67.     (modify-syntax-entry ?> "." table)
  68.     (modify-syntax-entry ?\' "\"" table)
  69.     (setq m2-mode-syntax-table table)))
  70.  
  71. ;;; Added by TEP
  72. (defvar m2-mode-map nil
  73.   "Keymap used in Modula-2 mode.")
  74.  
  75. (if m2-mode-map ()
  76.   (let ((map (make-sparse-keymap)))
  77.     (define-key map "\^i" 'm2-tab)
  78.     (define-key map "\C-cb" 'm2-begin)
  79.     (define-key map "\C-cc" 'm2-case)
  80.     (define-key map "\C-cd" 'm2-definition)
  81.     (define-key map "\C-ce" 'm2-else)
  82.     (define-key map "\C-cf" 'm2-for)
  83.     (define-key map "\C-ch" 'm2-header)
  84.     (define-key map "\C-ci" 'm2-if)
  85.     (define-key map "\C-cm" 'm2-module)
  86.     (define-key map "\C-cl" 'm2-loop)
  87.     (define-key map "\C-co" 'm2-or)
  88.     (define-key map "\C-cp" 'm2-procedure)
  89.     (define-key map "\C-c\C-w" 'm2-with)
  90.     (define-key map "\C-cr" 'm2-record)
  91.     (define-key map "\C-cs" 'm2-stdio)
  92.     (define-key map "\C-ct" 'm2-type)
  93.     (define-key map "\C-cu" 'm2-until)
  94.     (define-key map "\C-cv" 'm2-var)
  95.     (define-key map "\C-cw" 'm2-while)
  96.     (define-key map "\C-cx" 'm2-export)
  97.     (define-key map "\C-cy" 'm2-import)
  98.     (define-key map "\C-c{" 'm2-begin-comment)
  99.     (define-key map "\C-c}" 'm2-end-comment)
  100.     (define-key map "\C-j"  'm2-newline)
  101.     (define-key map "\C-c\C-z" 'suspend-emacs)
  102.     (define-key map "\C-c\C-v" 'm2-visit)
  103.     (define-key map "\C-c\C-t" 'm2-toggle)
  104.     (define-key map "\C-c\C-l" 'm2-link)
  105.     (define-key map "\C-c\C-c" 'm2-compile)
  106.     (setq m2-mode-map map)))
  107.  
  108. (defvar m2-indent 5 "*This variable gives the indentation in Modula-2-Mode")
  109.   
  110. ;;;###autoload
  111. (defun modula-2-mode ()
  112.   "This is a mode intended to support program development in Modula-2.
  113. All control constructs of Modula-2 can be reached by typing C-c
  114. followed by the first character of the construct.
  115. \\<m2-mode-map>
  116.   \\[m2-begin] begin         \\[m2-case] case
  117.   \\[m2-definition] definition    \\[m2-else] else
  118.   \\[m2-for] for           \\[m2-header] header
  119.   \\[m2-if] if            \\[m2-module] module
  120.   \\[m2-loop] loop          \\[m2-or] or
  121.   \\[m2-procedure] procedure     Control-c Control-w with
  122.   \\[m2-record] record        \\[m2-stdio] stdio
  123.   \\[m2-type] type          \\[m2-until] until
  124.   \\[m2-var] var           \\[m2-while] while
  125.   \\[m2-export] export        \\[m2-import] import
  126.   \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment
  127.   \\[suspend-emacs] suspend Emacs     \\[m2-toggle] toggle
  128.   \\[m2-compile] compile           \\[m2-next-error] next-error
  129.   \\[m2-link] link
  130.  
  131.    `m2-indent' controls the number of spaces for each indentation.
  132.    `m2-compile-command' holds the command to compile a Modula-2 program.
  133.    `m2-link-command' holds the command to link a Modula-2 program."
  134.   (interactive)
  135.   (kill-all-local-variables)
  136.   (use-local-map m2-mode-map)
  137.   (setq major-mode 'modula-2-mode)
  138.   (setq mode-name "Modula-2")
  139.   (make-local-variable 'comment-column)
  140.   (setq comment-column 41)
  141.   (make-local-variable 'end-comment-column)
  142.   (setq end-comment-column 75)
  143.   (set-syntax-table m2-mode-syntax-table)
  144.   (make-local-variable 'paragraph-start)
  145.   (setq paragraph-start (concat "$\\|" page-delimiter))
  146.   (make-local-variable 'paragraph-separate)
  147.   (setq paragraph-separate paragraph-start)
  148.   (make-local-variable 'paragraph-ignore-fill-prefix)
  149.   (setq paragraph-ignore-fill-prefix t)
  150. ;  (make-local-variable 'indent-line-function)
  151. ;  (setq indent-line-function 'c-indent-line)
  152.   (make-local-variable 'require-final-newline)
  153.   (setq require-final-newline t)
  154.   (make-local-variable 'comment-start)
  155.   (setq comment-start "(* ")
  156.   (make-local-variable 'comment-end)
  157.   (setq comment-end " *)")
  158.   (make-local-variable 'comment-column)
  159.   (setq comment-column 41)
  160.   (make-local-variable 'comment-start-skip)
  161.   (setq comment-start-skip "/\\*+ *")
  162.   (make-local-variable 'comment-indent-function)
  163.   (setq comment-indent-function 'c-comment-indent)
  164.   (make-local-variable 'parse-sexp-ignore-comments)
  165.   (setq parse-sexp-ignore-comments t)
  166.   (run-hooks 'm2-mode-hook))
  167.  
  168. (defun m2-newline ()
  169.   "Insert a newline and indent following line like previous line."
  170.   (interactive)
  171.   (let ((hpos (current-indentation)))
  172.     (newline)
  173.     (indent-to hpos)))
  174.  
  175. (defun m2-tab ()
  176.   "Indent to next tab stop."
  177.   (interactive)
  178.   (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent)))
  179.  
  180. (defun m2-begin ()
  181.   "Insert a BEGIN keyword and indent for the next line."
  182.   (interactive)
  183.   (insert "BEGIN")
  184.   (m2-newline)
  185.   (m2-tab))
  186.  
  187. (defun m2-case ()
  188.   "Build skeleton CASE statement, prompting for the <expression>."
  189.   (interactive)
  190.   (let ((name (read-string "Case-Expression: ")))
  191.     (insert "CASE " name " OF")
  192.     (m2-newline)
  193.     (m2-newline)
  194.     (insert "END (* case " name " *);"))
  195.   (end-of-line 0)
  196.   (m2-tab))
  197.  
  198. (defun m2-definition ()
  199.   "Build skeleton DEFINITION MODULE, prompting for the <module name>."
  200.   (interactive)
  201.   (insert "DEFINITION MODULE ")
  202.   (let ((name (read-string "Name: ")))
  203.     (insert name ";\n\n\n\nEND " name ".\n"))
  204.   (previous-line 3))
  205.  
  206. (defun m2-else ()
  207.   "Insert ELSE keyword and indent for next line."
  208.   (interactive)
  209.   (m2-newline)
  210.   (backward-delete-char-untabify m2-indent ())
  211.   (insert "ELSE")
  212.   (m2-newline)
  213.   (m2-tab))
  214.  
  215. (defun m2-for ()
  216.   "Build skeleton FOR loop statement, prompting for the loop parameters."
  217.   (interactive)
  218.   (insert "FOR ")
  219.   (let ((name (read-string "Loop Initialiser: ")) limit by)
  220.     (insert name " TO ")
  221.     (setq limit (read-string "Limit: "))
  222.     (insert limit)
  223.     (setq by (read-string "Step: "))
  224.     (if (not (string-equal by ""))
  225.     (insert " BY " by))
  226.     (insert " DO")
  227.     (m2-newline)
  228.     (m2-newline)
  229.     (insert "END (* for " name " to " limit " *);"))
  230.   (end-of-line 0)
  231.   (m2-tab))
  232.  
  233. (defun m2-header ()
  234.   "Insert a comment block containing the module title, author, etc."
  235.   (interactive)
  236.   (insert "(*\n    Title: \t")
  237.   (insert (read-string "Title: "))
  238.   (insert "\n    Created:\t")
  239.   (insert (current-time-string))
  240.   (insert "\n    Author: \t")
  241.   (insert (user-full-name))
  242.   (insert (concat "\n\t\t<" (user-login-name) "@" (system-name) ">\n"))
  243.   (insert "*)\n\n"))
  244.  
  245. (defun m2-if ()
  246.   "Insert skeleton IF statement, prompting for <boolean-expression>."
  247.   (interactive)
  248.   (insert "IF ")
  249.   (let ((thecondition (read-string "<boolean-expression>: ")))
  250.     (insert thecondition " THEN")
  251.     (m2-newline)
  252.     (m2-newline)
  253.     (insert "END (* if " thecondition " *);"))
  254.   (end-of-line 0)
  255.   (m2-tab))
  256.  
  257. (defun m2-loop ()
  258.   "Build skeleton LOOP (with END)."
  259.   (interactive)
  260.   (insert "LOOP")
  261.   (m2-newline)
  262.   (m2-newline)
  263.   (insert "END (* loop *);")
  264.   (end-of-line 0)
  265.   (m2-tab))
  266.  
  267. (defun m2-module ()
  268.   "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>."
  269.   (interactive)
  270.   (insert "IMPLEMENTATION MODULE ")
  271.   (let ((name (read-string "Name: ")))
  272.     (insert name ";\n\n\n\nEND " name ".\n")
  273.     (previous-line 3)
  274.     (m2-header)
  275.     (m2-type)
  276.     (newline)
  277.     (m2-var)
  278.     (newline)
  279.     (m2-begin)
  280.     (m2-begin-comment)
  281.     (insert " Module " name " Initialisation Code "))
  282.   (m2-end-comment)
  283.   (newline)
  284.   (m2-tab))
  285.  
  286. (defun m2-or ()
  287.   (interactive)
  288.   (m2-newline)
  289.   (backward-delete-char-untabify m2-indent)
  290.   (insert "|")
  291.   (m2-newline)
  292.   (m2-tab))
  293.  
  294. (defun m2-procedure ()
  295.   (interactive)
  296.   (insert "PROCEDURE ")
  297.   (let ((name (read-string "Name: " ))
  298.     args)
  299.     (insert name " (")
  300.     (insert (read-string "Arguments: ") ")")
  301.     (setq args (read-string "Result Type: "))
  302.     (if (not (string-equal args ""))
  303.     (insert " : " args))
  304.     (insert ";")
  305.     (m2-newline)
  306.     (insert "BEGIN")
  307.     (m2-newline)
  308.     (m2-newline)
  309.     (insert "END ")
  310.     (insert name)
  311.     (insert ";")
  312.     (end-of-line 0)
  313.     (m2-tab)))
  314.  
  315. (defun m2-with ()
  316.   (interactive)
  317.   (insert "WITH ")
  318.   (let ((name (read-string "Record-Type: ")))
  319.     (insert name)
  320.     (insert " DO")
  321.     (m2-newline)
  322.     (m2-newline)
  323.     (insert "END (* with " name " *);"))
  324.   (end-of-line 0)
  325.   (m2-tab))
  326.  
  327. (defun m2-record ()
  328.   (interactive)
  329.   (insert "RECORD")
  330.   (m2-newline)
  331.   (m2-newline)
  332.   (insert "END (* record *);")
  333.   (end-of-line 0)
  334.   (m2-tab))
  335.  
  336. (defun m2-stdio ()
  337.   (interactive)
  338.   (insert "
  339. FROM TextIO IMPORT 
  340.    WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER,
  341.    WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN,
  342.    WriteREAL, ReadREAL, WriteBITSET, ReadBITSET,
  343.    WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars,
  344.    WriteString, ReadString, WhiteSpace, EndOfLine;
  345.  
  346. FROM SysStreams IMPORT sysIn, sysOut, sysErr;
  347.  
  348. "))
  349.  
  350. (defun m2-type ()
  351.   (interactive)
  352.   (insert "TYPE")
  353.   (m2-newline)
  354.   (m2-tab))
  355.  
  356. (defun m2-until ()
  357.   (interactive)
  358.   (insert "REPEAT")
  359.   (m2-newline)
  360.   (m2-newline)
  361.   (insert "UNTIL ")
  362.   (insert (read-string "<boolean-expression>: ") ";")
  363.   (end-of-line 0)
  364.   (m2-tab))
  365.  
  366. (defun m2-var ()
  367.   (interactive)
  368.   (m2-newline)
  369.   (insert "VAR")
  370.   (m2-newline)
  371.   (m2-tab))
  372.  
  373. (defun m2-while ()
  374.   (interactive)
  375.   (insert "WHILE ")
  376.   (let ((name (read-string "<boolean-expression>: ")))
  377.     (insert name " DO" )
  378.     (m2-newline)
  379.     (m2-newline)
  380.     (insert "END (* while " name " *);"))
  381.   (end-of-line 0)
  382.   (m2-tab))
  383.  
  384. (defun m2-export ()
  385.   (interactive)
  386.   (insert "EXPORT QUALIFIED "))
  387.  
  388. (defun m2-import ()
  389.   (interactive)
  390.   (insert "FROM ")
  391.   (insert (read-string "Module: "))
  392.   (insert " IMPORT "))
  393.  
  394. (defun m2-begin-comment ()
  395.   (interactive)
  396.   (if (not (bolp))
  397.       (indent-to comment-column 0))
  398.   (insert "(*  "))
  399.  
  400. (defun m2-end-comment ()
  401.   (interactive)
  402.   (if (not (bolp))
  403.       (indent-to end-comment-column))
  404.   (insert "*)"))
  405.  
  406. (defun m2-compile ()
  407.   (interactive)
  408.   (setq modulename (buffer-name))
  409.   (compile (concat m2-compile-command " " modulename)))
  410.  
  411. (defun m2-link ()
  412.   (interactive)
  413.   (setq modulename (buffer-name))
  414.   (if m2-link-name
  415.       (compile (concat m2-link-command " " m2-link-name))
  416.     (compile (concat m2-link-command " "
  417.              (setq m2-link-name (read-string "Name of executable: "
  418.                              modulename))))))
  419.  
  420. (defun m2-execute-monitor-command (command)
  421.   (let* ((shell shell-file-name)
  422.      (csh (equal (file-name-nondirectory shell) "csh")))
  423.     (call-process shell nil t t "-cf" (concat "exec " command))))
  424.  
  425. (defun m2-visit ()
  426.   (interactive)
  427.   (let ((deffile nil)
  428.     (modfile nil)
  429.     modulename)
  430.     (save-excursion
  431.       (setq modulename
  432.         (read-string "Module name: "))
  433.       (switch-to-buffer "*Command Execution*")
  434.       (m2-execute-monitor-command (concat "m2whereis " modulename))
  435.       (goto-char (point-min))
  436.       (condition-case ()
  437.       (progn (re-search-forward "\\(.*\\.def\\) *$")
  438.          (setq deffile (buffer-substring (match-beginning 1)
  439.                          (match-end 1))))
  440.     (search-failed ()))
  441.       (condition-case ()
  442.       (progn (re-search-forward "\\(.*\\.mod\\) *$")
  443.          (setq modfile (buffer-substring (match-beginning 1)
  444.                          (match-end 1))))
  445.     (search-failed ()))
  446.       (if (not (or deffile modfile))
  447.       (error "I can find neither definition nor implementation of %s"
  448.          modulename)))
  449.     (cond (deffile
  450.         (find-file deffile)
  451.         (if modfile
  452.         (save-excursion
  453.           (find-file modfile))))
  454.       (modfile
  455.        (find-file modfile)))))
  456.  
  457. (defun m2-toggle ()
  458.   "Toggle between .mod and .def files for the module."
  459.   (interactive)
  460.   (cond ((string-equal (substring (buffer-name) -4) ".def")
  461.      (find-file-other-window
  462.       (concat (substring (buffer-name) 0 -4) ".mod")))
  463.     ((string-equal (substring (buffer-name) -4) ".mod")
  464.      (find-file-other-window
  465.       (concat (substring (buffer-name) 0 -4)  ".def")))
  466.     ((string-equal (substring (buffer-name) -3) ".mi")
  467.      (find-file-other-window
  468.       (concat (substring (buffer-name) 0 -3)  ".md")))
  469.     ((string-equal (substring (buffer-name) -3) ".md")
  470.      (find-file-other-window
  471.       (concat (substring (buffer-name) 0 -3)  ".mi")))))
  472.  
  473. ;;; modula2.el ends here
  474.